###########################################################################
# plugin that allows Perlbal to launch other daemons on the fly  
###########################################################################
#
# paulv@bikkel.org / paulv@dds.nl 
#
# TODO: request headers komen niet mee? 

package Perlbal::Plugin::Shepherd;

use CDB_File;
use strict;
use warnings;
no  warnings qw(deprecated);

our $dogref;
our %dog;
our %status;
our %sconfig;  # service_name => $svc

sub load {
    my $class = shift;

    Perlbal::register_global_hook('manage_command.shepherd_cdb', sub {
        my $mc = shift->parse(qr/^shepherd_cdb\s*=\s*([\S\/\.]+)$/ ,
                "usage: SHEPHERD_CDB = </path/to/cdbfile/containing/user/to/port/mappings>");
        my ($shepherd_cdb) = $mc->args;

        return $mc->err("invalid portmap file : $shepherd_cdb") unless -f "$shepherd_cdb";

        if ( %dog ) {
               return $mc->ok;
        } else {
               %dog=();
               return $mc->err("could not read cdb file : '$shepherd_cdb'")  unless $dogref = tie(%dog,'CDB_File', $shepherd_cdb);
               return $mc->ok;
        }


    });

    return 1;
}


sub unload {
    	my $class = shift;

	untie %dog;
	Perlbal::unregister_global_hook('manage_command.shepherd_cdb');
	unregister($class, $_) foreach (values %sconfig);
	return 1; 
}


sub register {
    my ($class, $svc) = @_;

    unless ($svc && $svc->{role} eq "reverse_proxy" ) {
        die "You can't load the sheperd plugin on a service that is not a reverse proxy.\n";
    }

    $svc->register_hook('Shepherd', 'start_proxy_request', sub {

	my Perlbal::ClientProxy $client = $_[0];
	my Perlbal::HTTPHeaders $hds = $client->{req_headers};
	#my Perlbal::HTTPHeaders $rds = $client->{req_headers}->clone;

	my $rds = Perlbal::HTTPHeaders->new_response(200);
	my @nodes   = (@{$svc->{pool}->nodes });
	my $uri     = $hds->request_uri;

        if ( $uri =~ m#/[\w.-_]{1}/([\w.-_]+?)/# ) { 
        	my $user = $1; 
        	my $user_port = $dog{$user}; 
        	my $urls;
		my $node; 
		$hds->header('UserPort',$user_port);

        	foreach $node (@nodes) { $urls .= 'http://' . ${@{$node}}[0] . ':' . $user_port . $uri . ' ' }	
        	foreach $node (@nodes) { $urls .= 'http://' . ${@{$node}}[0] . ':' . ${@{$node}}[1] . $uri . ' ' } 	
        	return 1 if $client->start_reproxy_uri($rds, $urls); # if return eq 1 then perlbal will use this result
	}	

	return 0; # if 

    });

    return 1;
}

sub unregister {
    my ($class, $svc) = @_;
    $svc->unregister_hooks('Shepherd');
    delete $sconfig{"$svc"};
    return 1;
}

1;

__END__

=head1 NAME

Perlbal::Plugin::Shepherd -  plugin that redirect requests for user-space apache's to their userport 

=head1 VERSION

This documentation refers to C<Perlbal::Plugin::Shepherd> 

=head1 DESCRIPTION

Shepherd is a Perlbal plugin that when used as reverse-proxy plugin will try to decode from the request for what user the request 
is meant and redirect the  

=head1 CONFIGURING PERLBAL

To configure your Perlbal installation to use Shepard you'll need to C<LOAD> the plugin then add a service parameter to a C<reverse_proxy> service to activate it.

Example C<perlbal.conf>:

LOAD shepherd

CREATE SERVICE reverse_proxy 
  SET role             = reverse_proxy
  SET pool             = proxy_pool
  SET persist_backend  = off
  SET verify_backend   = off
  SET enable_reproxy   = on
  SET plugins          = shepherd
ENABLE reverse_proxy


=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.

Please report problems to the Perlbal mailing list, http://lists.danga.com/mailman/listinfo/perlbal/

Patches are welcome.

=head1 AUTHORS

Paul Vogel       <paulv@bikkel.org> 

=head1 LICENSE AND COPYRIGHT

Artistic/GPLv2, at your choosing.


